Heatmap of significant genes per cluster

hdWGCNA analysis

Load data and libraries

##################
# LOAD LIBRARIES #
##################
library(tidyverse)
library(Seurat)
library(SeuratObject)
library(tidyseurat)
library(hdWGCNA)
library(enrichR)
library(png)
library(cowplot)
library(patchwork)
library(openxlsx)

source("../../bin/spatial_visualization.R")
source("../../bin/plotting_functions.R")

#########
# PATHS #
#########
input_dir <- "../../results/06_DGE_condition_st_data/"
result_dir <- "./Figures/05/"
if( isFALSE(dir.exists(result_dir)) ) { dir.create(result_dir,recursive = TRUE) }
epi_clus <- "^5$|^6$|^7|^8" # res 0.7

ord <- c("Superficial", "Upper IM", "Lower IM", "Basal","1","4","0","3","2","9","10","11","12")
ord1 <- c("5", "6", "7", "8","1","4","0","3","2","9","10","11","12")
sample_id <- c("P020", "P045", "P050", "P057",
               "P008", "P031", "P044","P080", "P026", "P105", 
               "P001", "P004", "P014", "P018", "P087", "P118",
               "P021", "P024", "P067", "P081", "P117" ) %>% set_names()

#############
# LOAD DATA #
#############
# hdWGCNA
DATA <- readRDS(paste0("../../results/09_hdWGCNA/","hdWGCNA_3771DEGs_Seurat.RDS"))
modules <- read_csv(paste0("../../results/09_hdWGCNA/", "wgcna_3771DEGs_modules.csv"))

# DATA <- readRDS(paste0("../../results/09_hdWGCNA/",,"all_Clus_4000DEGs/","hdWGCNA_Seurat.RDS"))
# modules <- read_csv(paste0("../../results/09_hdWGCNA/all_Clus_4000DEGs/", "wgcna_all_Clus_modules.csv"))
# plot the dendrogram
png(paste0("./Figures/05/", "Spatial_hdWGCNA_dendrogram.png"), 
    width = 10, height = 3, units = "in", res = 300)
PlotDendrogram(DATA, main=NA, marAll = c(1, 4, 1, 0))
dev.off()
## quartz_off_screen 
##                 2
dend <- readPNG("./Figures/05/Spatial_hdWGCNA_dendrogram.png")
g <- grid::rasterGrob(dend, interpolate=TRUE) 

A <- ggplot() +
  annotation_custom(g, xmin=-Inf, xmax=Inf, ymin=-Inf, ymax=Inf) +
  theme_nothing() +
  theme(rect = element_blank(), # removes the box around the plot)
        plot.margin = unit(c(-0,0,0,0), "lines")) #t,r,b,l  

# dev.new(width=3.5, height=3, noRStudioGD = TRUE)
A

# get module eigengenes and gene-module assignment tables
MEs <-  DATA@misc[["vis"]][["MEs"]]
# add the MEs to the seurat metadata so we can plot it with Seurat functions
DATA@meta.data <- cbind(DATA@meta.data, MEs)

# plot with Seurat's DotPlot function
mods <- unique(modules$module)[unique(modules$module) != 'grey']
p <- c('groups', 'layers') %>%
  map(., ~DotPlot(DATA, features=rev(mods), group.by = .x, dot.min=0.1) )

# flip the x/y axes, rotate the axis labels, and change color scheme:
p <- map(p,~.x +
  coord_flip() +
  RotatedAxis() +
  scale_color_gradientn(colours = c('blue','grey95', 'red'), name = "Avg. Expression",
                       limits = c(-1.5, 2.5), oob = scales::squish,
                       values = scales::rescale(c(-1.5, 0, 2.5))) + 
    theme(axis.text = element_text(size = 10),
          legend.text = element_text(size = 9), legend.title =element_text(size = 10),
          axis.line = element_line(size = .4), # , colour = "#bebebe"
          axis.ticks = element_line(size = .4), # , colour = "#bebebe"
          legend.direction = "vertical", legend.box = "horizontal",
          legend.margin=margin(1,-1,1,6),
          plot.margin = unit(c(.7, -0, -1.2, -1), "lines")) + # t,r,b,l
    xlab('') + ylab('') + guides(col = guide_colourbar(barwidth = .3, barheight = 4 )) 
)

# combine plots
# dev.new(width=3.9, height=3.3, noRStudioGD = TRUE)
leg <- get_legend(p[[1]])
p1 <- plot_grid(p[[1]]+theme(legend.position = "none"),NULL, rel_widths = c(1, 1.3))
(B <- plot_grid(p1, p[[2]]+theme(legend.position = "none"),rel_heights = c(.75,1,1), ncol = 1) )

ggsave(filename=paste0("./Figures/05/", "dot-plot.png"),B,  width = 3.9, height = 3.3, bg = "white")
# relative expression level of each module
plot_list <- ModuleRadarPlot(
  arrange(DATA, layers),
  group.by = 'groups', combine = F, # ncol = 4, 
  #barcodes = seurat_obj@meta.data %>% subset(cell_type == 'INH') %>% rownames(),
  axis.label.size=3, group.line.width =  0.3, grid.line.width = 0.3, gridline.max.linetype = "dashed",
  grid.label.size=3
) 

# dev.new(width=5.5, height=2, noRStudioGD = TRUE)
(C <- wrap_plots(plot_list, ncol=4) & theme(title = element_text(size=8), plot.margin = unit(c(.1, -0, -1, -0), "lines")) )

# ggsave(filename=paste0("./Figures/05/", "Group_contribution.png"),C,  width = 10, height = 3, bg = "white")
plot_filt.fun <- function(DATA, gr = "L1"){
  DAT <- filter(DATA, groups == gr)
  DAT@misc[["vis"]][["MEs"]] <- DATA@misc[["vis"]][["MEs"]][colnames(DAT),]
  plot_list <- ModuleFeaturePlot(DAT, reduction = "umapharmony", features = "MEs", title =F) 
  return(plot_list)
}

mod <-  c("SM1", "SM2", "SM3", "SM4") # , "SM5", "SM6"
mod <- map(mod, ~plot_genes.fun(DATA, 
               gene = .x, 
               scale = F,
               mins = -20, maxs = 20,
               diverging = T,
               col = rev(c("#c41625","#dc4e43","#fa9975","#FDDBC7","#F7F7F7","#D1E5F0","#92C5DE","#4393C3","#2166AC")),
               point_size = .5,
               red="umapharmony", 
               lable = TRUE) + ggtitle(" ") + theme(plot.title = element_text(hjust = 0))) # size = 3

# dev.new(width=4, height=4, noRStudioGD = TRUE)
(D_1 <- map(seq_along(mod), ~mod[[.x]] + facet_wrap(~groups, ncol = 4)) %>% wrap_plots(., ncol=1) )

# ggsave(filename=paste0("./Figures/05/", "Modules_across_groups_UMAP.png"),D_1,  width = 10, height = 10, bg = "white")
# enrichr databases to test
dbs <- c('GO_Biological_Process_2021','KEGG_2021_Human','Transcription_Factor_PPIs')

# perform enrichment tests
DATA <- RunEnrichr( #map(dbs, ~
  DATA,
  dbs=dbs, # character vector of enrichr databases to test
  max_genes = Inf # number of genes per module to test. use max_genes = Inf to choose all genes!
)
## Uploading data to Enrichr... Done.
##   Querying GO_Biological_Process_2021... Done.
##   Querying KEGG_2021_Human... Done.
##   Querying Transcription_Factor_PPIs... Done.
## Parsing results... Done.
## Uploading data to Enrichr... Done.
##   Querying GO_Biological_Process_2021... Done.
##   Querying KEGG_2021_Human... Done.
##   Querying Transcription_Factor_PPIs... Done.
## Parsing results... Done.
## Uploading data to Enrichr... Done.
##   Querying GO_Biological_Process_2021... Done.
##   Querying KEGG_2021_Human... Done.
##   Querying Transcription_Factor_PPIs... Done.
## Parsing results... Done.
## Uploading data to Enrichr... Done.
##   Querying GO_Biological_Process_2021... Done.
##   Querying KEGG_2021_Human... Done.
##   Querying Transcription_Factor_PPIs... Done.
## Parsing results... Done.
# retrieve the output table
enrich_df <- GetEnrichrTable(DATA) %>%
  filter(Adjusted.P.value < 0.05) %>% 
  split(~db)

enrich_df %>%
  map(., ~split(.x, ~module)) %>%
  imap(., ~write.xlsx(.x, paste0(result_dir,"New_3771DEGs/", "Enrichment_",.y,".xlsx")) )
## $GO_Biological_Process_2021
## A Workbook object.
##  
## Worksheets:
##  Sheet 1: "SM1"
##  
## 
##  Sheet 2: "SM2"
##  
## 
##  Sheet 3: "SM3"
##  
## 
##  Sheet 4: "SM4"
##  
## 
##  
##  Worksheet write order: 1, 2, 3, 4
##  Active Sheet 1: "SM1" 
##  Position: 1
## 
## 
## $KEGG_2021_Human
## A Workbook object.
##  
## Worksheets:
##  Sheet 1: "SM1"
##  
## 
##  Sheet 2: "SM2"
##  
## 
##  Sheet 3: "SM3"
##  
## 
##  
##  Worksheet write order: 1, 2, 3
##  Active Sheet 1: "SM1" 
##  Position: 1
## 
## 
## $Transcription_Factor_PPIs
## A Workbook object.
##  
## Worksheets:
##  Sheet 1: "SM1"
##  
## 
##  Sheet 2: "SM2"
##  
## 
##  Sheet 3: "SM3"
##  
## 
##  Sheet 4: "SM4"
##  
## 
##  
##  Worksheet write order: 1, 2, 3, 4
##  Active Sheet 1: "SM1" 
##  Position: 1
# saveRDS(enrich_df, paste0("../../results/09_hdWGCNA/New_3771DEGs/", "Enrichment.RDS"))
# enrich_df <- readRDS(paste0("../../results/09_hdWGCNA/New_3771DEGs/", "Enrichment.RDS"))
#######################
# ENRICHMENT BARPLOT #
#######################
overlap.fun <- function(string){
  l <- str_split(string, pattern ="/")
  l <- map_dbl(l, ~as.numeric(.x[1])/as.numeric(.x[2]) )
  return(l)}

# str_match("cytoplasmic translation (GO:0002181)", "^(.+?)\\s\\((.+)\\)$")[2]
GeneRatio_plot.fun <- function(enrich_df, txt_size = 15, nr_path=3,
                               col=c("#ed968c","#f9d14a","#88a0dc","#e78429")){
  dot_df <- enrich_df %>%  # dot_df <- enrich_df$GO_Biological_Process_2021 %>%
    {if(grepl("GO",.$Term[[1]])){mutate(., "Term" = str_match(.$Term, "^(.+?)\\s\\((.+)\\)$")[,2], 
           "GOid" = str_match(.$Term, "^(.+?)\\s\\((.+)\\)$")[,3] )}else .} %>%
    filter(Adjusted.P.value < 0.05) %>%
    mutate("-log10(P-value)" = -log10(P.value)) %>%
    mutate(GeneRatio = overlap.fun(.$Overlap)*100) 
  
  dot_df <- dot_df %>%
    group_by(module) %>% 
    top_n(., -nr_path, Adjusted.P.value) 
  
  p <- ggplot(dot_df, aes(x = `-log10(P-value)`, y = fct_reorder(Term, `-log10(P-value)`), fill = module, col = module)) +
    geom_col(width = .05, show.legend = F) +
    geom_point(aes(size = GeneRatio)) + theme_classic() + 
    scale_fill_manual(values = col, aesthetics = c("fill", "colour")) +
    
    facet_wrap(~module, scales = 'free', ncol = 1) +
    #scale_x_continuous(expand = c(0, 1.5)) +
    coord_cartesian(clip = F) +
    scale_x_continuous(limits = function(x){c(0, +max(0.1, x))}) +
    scale_size_continuous(breaks = c(10, 50, 80)) +
    theme(axis.title.y = element_blank(),
          strip.text.x = element_text(hjust = 0.1, margin=margin(l=0)),
          strip.background = element_blank(),
          panel.spacing = unit(1, "lines"),
          axis.text.y = element_text(size = 10),
          panel.border = element_blank())
  return(p)
}

df <- bind_rows(enrich_df[[2]], enrich_df[[3]]) %>%
  filter(db == "Transcription_Factor_PPIs" & module == "SM4" | db == "KEGG_2021_Human")

# dev.new(width=3.5, height=5, noRStudioGD = TRUE)
(D_2 <- GeneRatio_plot.fun(df) + theme(legend.position = "none") )

# ggsave(paste0("./Figures/05/", "Enrichment.png"),D_2,  width = 3.8, height = 5, bg = "white")
######################
# COMBINE ALL PANELS #
######################
# dev.new(width=7, height=8, noRStudioGD = TRUE) 
A_C <- plot_grid(A, C, ncol = 1, rel_widths = c(1, .4))
A_B_C <- plot_grid(A_C, B, ncol = 2)
D <- plot_grid(D_1, D_2)
(Figure5 <- plot_grid(A_B_C, D, ncol = 1, rel_heights = c(0.33, .66)) )

LS0tCnRpdGxlOiAiRmlndXJlIDUiCmRhdGU6ICJgciBmb3JtYXQoU3lzLnRpbWUoKSwgJyVkLSVtLSVZJylgIgpmb3JtYXQ6CiAgaHRtbDoKICAgIGVtYmVkLXJlc291cmNlczogdHJ1ZQogICAgY29kZS1mb2xkOiBzaG93CnBhcmFtczoKICBmaWcucGF0aDogImByIHBhc3RlMChwYXJhbXMkZmlnLnBhdGgpYCIgIy4vRmlndXJlcy8KZWRpdG9yX29wdGlvbnM6IAogIGNodW5rX291dHB1dF90eXBlOiBjb25zb2xlCi0tLQojIyBIZWF0bWFwIG9mIHNpZ25pZmljYW50IGdlbmVzIHBlciBjbHVzdGVyCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRX0Ka25pdHI6Om9wdHNfY2h1bmskc2V0KAogIGZpZy53aWR0aCAgICAgPSA2LjY5MjkxMzM4NTgsCiAgZmlnLnBhdGggICAgICA9IHBhcmFtcyRmaWcucGF0aCwjIi4uL0ZpZ3VyZXMvIiwKICBmaWcuYWxpZ24gICAgID0gImNlbnRlciIsCiAgbWVzc2FnZSAgICAgICA9IEZBTFNFLAogIHdhcm5pbmcgICAgICAgPSBGQUxTRSwKICBkZXYgICAgICAgICAgID0gYygicG5nIiksCiAgZHBpICAgICAgICAgICA9IDMwMCwKICBmaWcucHJvY2VzcyA9IGZ1bmN0aW9uKGZpbGVuYW1lKXsKICAgIG5ld19maWxlbmFtZSA8LSBzdHJpbmdyOjpzdHJfcmVtb3ZlKHN0cmluZyA9IGZpbGVuYW1lLAogICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgcGF0dGVybiA9ICItMSIpCiAgICBmczo6ZmlsZV9tb3ZlKHBhdGggPSBmaWxlbmFtZSwgbmV3X3BhdGggPSBuZXdfZmlsZW5hbWUpCiAgICBpZmVsc2UoZnM6OmZpbGVfZXhpc3RzKG5ld19maWxlbmFtZSksIG5ld19maWxlbmFtZSwgZmlsZW5hbWUpCiAgfQogICkKIyAgc2V0d2QoIn4vd29yay9Ccm9saWRlbnNfd29yay9Qcm9qZWN0cy9TcGF0aWFsX01pY3JvYmlvdGEvc3JjL01hbnVzY3JpcHQiKQpgYGAKCiMjIGhkV0dDTkEgYW5hbHlzaXMKYGBge3IgYmFja2dyb3VuZF9qb2IsIGV2YWw9RkFMU0UsIGluY2x1ZGU9RkFMU0V9CnNvdXJjZSgiLi4vLi4vYmluL3JlbmRlcl93aXRoX2pvYnMuUiIpCgojIHF1YXJ0bwojIHJlbmRlcl9odG1sX3dpdGhfam9iKG91dF9kaXIgPSBsYWJfZGlyKQojIGZzOjpmaWxlX21vdmUocGF0aCA9IGZpbGUsIG5ld19wYXRoID0gcGFzdGUwKGxhYl9kaXIsIGZpbGUpKQoKIyBjdXJyZW50bHkgdXNpbmcgcXVhcnRvIGZvciBnaXRodWIgYW5kIGtuaXRlciBmb3IgaHRtbCBkdWUgdG8gc291cmNlIGNvZGUgb3B0aW9uIApyZW5kZXJfZ2l0X3dpdGhfam9iKGZpZ19wYXRoID0gIi4vRmlndXJlcy8wMiYwMy8iKQpzeXN0ZW0yKGNvbW1hbmQgPSAic2VkIiwgc3Rkb3V0ID0gVFJVRSwKICAgICAgICBhcmdzID0gYygiLWkiLCAiJyciLCItZSIsICdzL3NyYz1cXCJcXC4vc3JjPVxcIlxcLlxcLi9nJywKICAgICAgICAgICAgICAgICBwYXN0ZTAoIi4vbWRfZmlsZXMvIiwgYmFzZW5hbWUoIi4vMDVfZmlndXJlcy5tZCIpKSkpCgojIGtuaXRlcgprbml0X2h0bWxfd2l0aF9qb2Iob3V0X2RpciA9ICIuLi8uLi9sYWJfYm9vay9maWd1cmVfMDUiLCBmaWdfcGF0aCA9ICIuL0ZpZ3VyZXMvMDUvIikKYGBgCgojIyMgTG9hZCBkYXRhIGFuZCBsaWJyYXJpZXMKYGBge3IgTG9hZF9kYXRhfQojIyMjIyMjIyMjIyMjIyMjIyMKIyBMT0FEIExJQlJBUklFUyAjCiMjIyMjIyMjIyMjIyMjIyMjIwpsaWJyYXJ5KHRpZHl2ZXJzZSkKbGlicmFyeShTZXVyYXQpCmxpYnJhcnkoU2V1cmF0T2JqZWN0KQpsaWJyYXJ5KHRpZHlzZXVyYXQpCmxpYnJhcnkoaGRXR0NOQSkKbGlicmFyeShlbnJpY2hSKQpsaWJyYXJ5KHBuZykKbGlicmFyeShjb3dwbG90KQpsaWJyYXJ5KHBhdGNod29yaykKbGlicmFyeShvcGVueGxzeCkKCnNvdXJjZSgiLi4vLi4vYmluL3NwYXRpYWxfdmlzdWFsaXphdGlvbi5SIikKc291cmNlKCIuLi8uLi9iaW4vcGxvdHRpbmdfZnVuY3Rpb25zLlIiKQoKIyMjIyMjIyMjCiMgUEFUSFMgIwojIyMjIyMjIyMKaW5wdXRfZGlyIDwtICIuLi8uLi9yZXN1bHRzLzA2X0RHRV9jb25kaXRpb25fc3RfZGF0YS8iCnJlc3VsdF9kaXIgPC0gIi4vRmlndXJlcy8wNS8iCmlmKCBpc0ZBTFNFKGRpci5leGlzdHMocmVzdWx0X2RpcikpICkgeyBkaXIuY3JlYXRlKHJlc3VsdF9kaXIscmVjdXJzaXZlID0gVFJVRSkgfQplcGlfY2x1cyA8LSAiXjUkfF42JHxeN3xeOCIgIyByZXMgMC43CgpvcmQgPC0gYygiU3VwZXJmaWNpYWwiLCAiVXBwZXIgSU0iLCAiTG93ZXIgSU0iLCAiQmFzYWwiLCIxIiwiNCIsIjAiLCIzIiwiMiIsIjkiLCIxMCIsIjExIiwiMTIiKQpvcmQxIDwtIGMoIjUiLCAiNiIsICI3IiwgIjgiLCIxIiwiNCIsIjAiLCIzIiwiMiIsIjkiLCIxMCIsIjExIiwiMTIiKQpzYW1wbGVfaWQgPC0gYygiUDAyMCIsICJQMDQ1IiwgIlAwNTAiLCAiUDA1NyIsCiAgICAgICAgICAgICAgICJQMDA4IiwgIlAwMzEiLCAiUDA0NCIsIlAwODAiLCAiUDAyNiIsICJQMTA1IiwgCiAgICAgICAgICAgICAgICJQMDAxIiwgIlAwMDQiLCAiUDAxNCIsICJQMDE4IiwgIlAwODciLCAiUDExOCIsCiAgICAgICAgICAgICAgICJQMDIxIiwgIlAwMjQiLCAiUDA2NyIsICJQMDgxIiwgIlAxMTciICkgJT4lIHNldF9uYW1lcygpCgojIyMjIyMjIyMjIyMjCiMgTE9BRCBEQVRBICMKIyMjIyMjIyMjIyMjIwojIGhkV0dDTkEKREFUQSA8LSByZWFkUkRTKHBhc3RlMCgiLi4vLi4vcmVzdWx0cy8wOV9oZFdHQ05BLyIsImhkV0dDTkFfMzc3MURFR3NfU2V1cmF0LlJEUyIpKQptb2R1bGVzIDwtIHJlYWRfY3N2KHBhc3RlMCgiLi4vLi4vcmVzdWx0cy8wOV9oZFdHQ05BLyIsICJ3Z2NuYV8zNzcxREVHc19tb2R1bGVzLmNzdiIpKQoKIyBEQVRBIDwtIHJlYWRSRFMocGFzdGUwKCIuLi8uLi9yZXN1bHRzLzA5X2hkV0dDTkEvIiwsImFsbF9DbHVzXzQwMDBERUdzLyIsImhkV0dDTkFfU2V1cmF0LlJEUyIpKQojIG1vZHVsZXMgPC0gcmVhZF9jc3YocGFzdGUwKCIuLi8uLi9yZXN1bHRzLzA5X2hkV0dDTkEvYWxsX0NsdXNfNDAwMERFR3MvIiwgIndnY25hX2FsbF9DbHVzX21vZHVsZXMuY3N2IikpCgpgYGAKCmBgYHtyIFNwYXRpYWxfaGRXR0NOQV9kZW5kcm9ncmFtLCBmaWcud2lkdGg9MTAsIGZpZy5oZWlnaHQ9M30KIyBwbG90IHRoZSBkZW5kcm9ncmFtCnBuZyhwYXN0ZTAoIi4vRmlndXJlcy8wNS8iLCAiU3BhdGlhbF9oZFdHQ05BX2RlbmRyb2dyYW0ucG5nIiksIAogICAgd2lkdGggPSAxMCwgaGVpZ2h0ID0gMywgdW5pdHMgPSAiaW4iLCByZXMgPSAzMDApClBsb3REZW5kcm9ncmFtKERBVEEsIG1haW49TkEsIG1hckFsbCA9IGMoMSwgNCwgMSwgMCkpCmRldi5vZmYoKQoKZGVuZCA8LSByZWFkUE5HKCIuL0ZpZ3VyZXMvMDUvU3BhdGlhbF9oZFdHQ05BX2RlbmRyb2dyYW0ucG5nIikKZyA8LSBncmlkOjpyYXN0ZXJHcm9iKGRlbmQsIGludGVycG9sYXRlPVRSVUUpIAoKQSA8LSBnZ3Bsb3QoKSArCiAgYW5ub3RhdGlvbl9jdXN0b20oZywgeG1pbj0tSW5mLCB4bWF4PUluZiwgeW1pbj0tSW5mLCB5bWF4PUluZikgKwogIHRoZW1lX25vdGhpbmcoKSArCiAgdGhlbWUocmVjdCA9IGVsZW1lbnRfYmxhbmsoKSwgIyByZW1vdmVzIHRoZSBib3ggYXJvdW5kIHRoZSBwbG90KQogICAgICAgIHBsb3QubWFyZ2luID0gdW5pdChjKC0wLDAsMCwwKSwgImxpbmVzIikpICN0LHIsYixsICAKCiMgZGV2Lm5ldyh3aWR0aD0zLjUsIGhlaWdodD0zLCBub1JTdHVkaW9HRCA9IFRSVUUpCkEKYGBgCgpgYGB7ciBkb3QtcGxvdHN9CiMgZ2V0IG1vZHVsZSBlaWdlbmdlbmVzIGFuZCBnZW5lLW1vZHVsZSBhc3NpZ25tZW50IHRhYmxlcwpNRXMgPC0gIERBVEFAbWlzY1tbInZpcyJdXVtbIk1FcyJdXQojIGFkZCB0aGUgTUVzIHRvIHRoZSBzZXVyYXQgbWV0YWRhdGEgc28gd2UgY2FuIHBsb3QgaXQgd2l0aCBTZXVyYXQgZnVuY3Rpb25zCkRBVEFAbWV0YS5kYXRhIDwtIGNiaW5kKERBVEFAbWV0YS5kYXRhLCBNRXMpCgojIHBsb3Qgd2l0aCBTZXVyYXQncyBEb3RQbG90IGZ1bmN0aW9uCm1vZHMgPC0gdW5pcXVlKG1vZHVsZXMkbW9kdWxlKVt1bmlxdWUobW9kdWxlcyRtb2R1bGUpICE9ICdncmV5J10KcCA8LSBjKCdncm91cHMnLCAnbGF5ZXJzJykgJT4lCiAgbWFwKC4sIH5Eb3RQbG90KERBVEEsIGZlYXR1cmVzPXJldihtb2RzKSwgZ3JvdXAuYnkgPSAueCwgZG90Lm1pbj0wLjEpICkKCiMgZmxpcCB0aGUgeC95IGF4ZXMsIHJvdGF0ZSB0aGUgYXhpcyBsYWJlbHMsIGFuZCBjaGFuZ2UgY29sb3Igc2NoZW1lOgpwIDwtIG1hcChwLH4ueCArCiAgY29vcmRfZmxpcCgpICsKICBSb3RhdGVkQXhpcygpICsKICBzY2FsZV9jb2xvcl9ncmFkaWVudG4oY29sb3VycyA9IGMoJ2JsdWUnLCdncmV5OTUnLCAncmVkJyksIG5hbWUgPSAiQXZnLiBFeHByZXNzaW9uIiwKICAgICAgICAgICAgICAgICAgICAgICBsaW1pdHMgPSBjKC0xLjUsIDIuNSksIG9vYiA9IHNjYWxlczo6c3F1aXNoLAogICAgICAgICAgICAgICAgICAgICAgIHZhbHVlcyA9IHNjYWxlczo6cmVzY2FsZShjKC0xLjUsIDAsIDIuNSkpKSArIAogICAgdGhlbWUoYXhpcy50ZXh0ID0gZWxlbWVudF90ZXh0KHNpemUgPSAxMCksCiAgICAgICAgICBsZWdlbmQudGV4dCA9IGVsZW1lbnRfdGV4dChzaXplID0gOSksIGxlZ2VuZC50aXRsZSA9ZWxlbWVudF90ZXh0KHNpemUgPSAxMCksCiAgICAgICAgICBheGlzLmxpbmUgPSBlbGVtZW50X2xpbmUoc2l6ZSA9IC40KSwgIyAsIGNvbG91ciA9ICIjYmViZWJlIgogICAgICAgICAgYXhpcy50aWNrcyA9IGVsZW1lbnRfbGluZShzaXplID0gLjQpLCAjICwgY29sb3VyID0gIiNiZWJlYmUiCiAgICAgICAgICBsZWdlbmQuZGlyZWN0aW9uID0gInZlcnRpY2FsIiwgbGVnZW5kLmJveCA9ICJob3Jpem9udGFsIiwKICAgICAgICAgIGxlZ2VuZC5tYXJnaW49bWFyZ2luKDEsLTEsMSw2KSwKICAgICAgICAgIHBsb3QubWFyZ2luID0gdW5pdChjKC43LCAtMCwgLTEuMiwgLTEpLCAibGluZXMiKSkgKyAjIHQscixiLGwKICAgIHhsYWIoJycpICsgeWxhYignJykgKyBndWlkZXMoY29sID0gZ3VpZGVfY29sb3VyYmFyKGJhcndpZHRoID0gLjMsIGJhcmhlaWdodCA9IDQgKSkgCikKCiMgY29tYmluZSBwbG90cwojIGRldi5uZXcod2lkdGg9My45LCBoZWlnaHQ9My4zLCBub1JTdHVkaW9HRCA9IFRSVUUpCmxlZyA8LSBnZXRfbGVnZW5kKHBbWzFdXSkKcDEgPC0gcGxvdF9ncmlkKHBbWzFdXSt0aGVtZShsZWdlbmQucG9zaXRpb24gPSAibm9uZSIpLE5VTEwsIHJlbF93aWR0aHMgPSBjKDEsIDEuMykpCihCIDwtIHBsb3RfZ3JpZChwMSwgcFtbMl1dK3RoZW1lKGxlZ2VuZC5wb3NpdGlvbiA9ICJub25lIikscmVsX2hlaWdodHMgPSBjKC43NSwxLDEpLCBuY29sID0gMSkgKQoKZ2dzYXZlKGZpbGVuYW1lPXBhc3RlMCgiLi9GaWd1cmVzLzA1LyIsICJkb3QtcGxvdC5wbmciKSxCLCAgd2lkdGggPSAzLjksIGhlaWdodCA9IDMuMywgYmcgPSAid2hpdGUiKQpgYGAKCmBgYHtyIHJhZGFyX3Bsb3R9CiMgcmVsYXRpdmUgZXhwcmVzc2lvbiBsZXZlbCBvZiBlYWNoIG1vZHVsZQpwbG90X2xpc3QgPC0gTW9kdWxlUmFkYXJQbG90KAogIGFycmFuZ2UoREFUQSwgbGF5ZXJzKSwKICBncm91cC5ieSA9ICdncm91cHMnLCBjb21iaW5lID0gRiwgIyBuY29sID0gNCwgCiAgI2JhcmNvZGVzID0gc2V1cmF0X29iakBtZXRhLmRhdGEgJT4lIHN1YnNldChjZWxsX3R5cGUgPT0gJ0lOSCcpICU+JSByb3duYW1lcygpLAogIGF4aXMubGFiZWwuc2l6ZT0zLCBncm91cC5saW5lLndpZHRoID0gIDAuMywgZ3JpZC5saW5lLndpZHRoID0gMC4zLCBncmlkbGluZS5tYXgubGluZXR5cGUgPSAiZGFzaGVkIiwKICBncmlkLmxhYmVsLnNpemU9MwopIAoKIyBkZXYubmV3KHdpZHRoPTUuNSwgaGVpZ2h0PTIsIG5vUlN0dWRpb0dEID0gVFJVRSkKKEMgPC0gd3JhcF9wbG90cyhwbG90X2xpc3QsIG5jb2w9NCkgJiB0aGVtZSh0aXRsZSA9IGVsZW1lbnRfdGV4dChzaXplPTgpLCBwbG90Lm1hcmdpbiA9IHVuaXQoYyguMSwgLTAsIC0xLCAtMCksICJsaW5lcyIpKSApCiMgZ2dzYXZlKGZpbGVuYW1lPXBhc3RlMCgiLi9GaWd1cmVzLzA1LyIsICJHcm91cF9jb250cmlidXRpb24ucG5nIiksQywgIHdpZHRoID0gMTAsIGhlaWdodCA9IDMsIGJnID0gIndoaXRlIikKYGBgCgoKYGBge3IgcGxvdC1tb2R1bGVzfQpwbG90X2ZpbHQuZnVuIDwtIGZ1bmN0aW9uKERBVEEsIGdyID0gIkwxIil7CiAgREFUIDwtIGZpbHRlcihEQVRBLCBncm91cHMgPT0gZ3IpCiAgREFUQG1pc2NbWyJ2aXMiXV1bWyJNRXMiXV0gPC0gREFUQUBtaXNjW1sidmlzIl1dW1siTUVzIl1dW2NvbG5hbWVzKERBVCksXQogIHBsb3RfbGlzdCA8LSBNb2R1bGVGZWF0dXJlUGxvdChEQVQsIHJlZHVjdGlvbiA9ICJ1bWFwaGFybW9ueSIsIGZlYXR1cmVzID0gIk1FcyIsIHRpdGxlID1GKSAKICByZXR1cm4ocGxvdF9saXN0KQp9Cgptb2QgPC0gIGMoIlNNMSIsICJTTTIiLCAiU00zIiwgIlNNNCIpICMgLCAiU001IiwgIlNNNiIKbW9kIDwtIG1hcChtb2QsIH5wbG90X2dlbmVzLmZ1bihEQVRBLCAKICAgICAgICAgICAgICAgZ2VuZSA9IC54LCAKICAgICAgICAgICAgICAgc2NhbGUgPSBGLAogICAgICAgICAgICAgICBtaW5zID0gLTIwLCBtYXhzID0gMjAsCiAgICAgICAgICAgICAgIGRpdmVyZ2luZyA9IFQsCiAgICAgICAgICAgICAgIGNvbCA9IHJldihjKCIjYzQxNjI1IiwiI2RjNGU0MyIsIiNmYTk5NzUiLCIjRkREQkM3IiwiI0Y3RjdGNyIsIiNEMUU1RjAiLCIjOTJDNURFIiwiIzQzOTNDMyIsIiMyMTY2QUMiKSksCiAgICAgICAgICAgICAgIHBvaW50X3NpemUgPSAuNSwKICAgICAgICAgICAgICAgcmVkPSJ1bWFwaGFybW9ueSIsIAogICAgICAgICAgICAgICBsYWJsZSA9IFRSVUUpICsgZ2d0aXRsZSgiICIpICsgdGhlbWUocGxvdC50aXRsZSA9IGVsZW1lbnRfdGV4dChoanVzdCA9IDApKSkgIyBzaXplID0gMwoKIyBkZXYubmV3KHdpZHRoPTQsIGhlaWdodD00LCBub1JTdHVkaW9HRCA9IFRSVUUpCihEXzEgPC0gbWFwKHNlcV9hbG9uZyhtb2QpLCB+bW9kW1sueF1dICsgZmFjZXRfd3JhcCh+Z3JvdXBzLCBuY29sID0gNCkpICU+JSB3cmFwX3Bsb3RzKC4sIG5jb2w9MSkgKQojIGdnc2F2ZShmaWxlbmFtZT1wYXN0ZTAoIi4vRmlndXJlcy8wNS8iLCAiTW9kdWxlc19hY3Jvc3NfZ3JvdXBzX1VNQVAucG5nIiksRF8xLCAgd2lkdGggPSAxMCwgaGVpZ2h0ID0gMTAsIGJnID0gIndoaXRlIikKYGBgCgpgYGB7ciBlbnJpY2hSfQojIGVucmljaHIgZGF0YWJhc2VzIHRvIHRlc3QKZGJzIDwtIGMoJ0dPX0Jpb2xvZ2ljYWxfUHJvY2Vzc18yMDIxJywnS0VHR18yMDIxX0h1bWFuJywnVHJhbnNjcmlwdGlvbl9GYWN0b3JfUFBJcycpCgojIHBlcmZvcm0gZW5yaWNobWVudCB0ZXN0cwpEQVRBIDwtIFJ1bkVucmljaHIoICNtYXAoZGJzLCB+CiAgREFUQSwKICBkYnM9ZGJzLCAjIGNoYXJhY3RlciB2ZWN0b3Igb2YgZW5yaWNociBkYXRhYmFzZXMgdG8gdGVzdAogIG1heF9nZW5lcyA9IEluZiAjIG51bWJlciBvZiBnZW5lcyBwZXIgbW9kdWxlIHRvIHRlc3QuIHVzZSBtYXhfZ2VuZXMgPSBJbmYgdG8gY2hvb3NlIGFsbCBnZW5lcyEKKQoKIyByZXRyaWV2ZSB0aGUgb3V0cHV0IHRhYmxlCmVucmljaF9kZiA8LSBHZXRFbnJpY2hyVGFibGUoREFUQSkgJT4lCiAgZmlsdGVyKEFkanVzdGVkLlAudmFsdWUgPCAwLjA1KSAlPiUgCiAgc3BsaXQofmRiKQoKZW5yaWNoX2RmICU+JQogIG1hcCguLCB+c3BsaXQoLngsIH5tb2R1bGUpKSAlPiUKICBpbWFwKC4sIH53cml0ZS54bHN4KC54LCBwYXN0ZTAocmVzdWx0X2RpciwiTmV3XzM3NzFERUdzLyIsICJFbnJpY2htZW50XyIsLnksIi54bHN4IikpICkKCiMgc2F2ZVJEUyhlbnJpY2hfZGYsIHBhc3RlMCgiLi4vLi4vcmVzdWx0cy8wOV9oZFdHQ05BL05ld18zNzcxREVHcy8iLCAiRW5yaWNobWVudC5SRFMiKSkKIyBlbnJpY2hfZGYgPC0gcmVhZFJEUyhwYXN0ZTAoIi4uLy4uL3Jlc3VsdHMvMDlfaGRXR0NOQS9OZXdfMzc3MURFR3MvIiwgIkVucmljaG1lbnQuUkRTIikpCgpgYGAKCmBgYHtyIEVucmljaG1lbnQtcGxvdH0KIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMKIyBFTlJJQ0hNRU5UIEJBUlBMT1QgIwojIyMjIyMjIyMjIyMjIyMjIyMjIyMjIwpvdmVybGFwLmZ1biA8LSBmdW5jdGlvbihzdHJpbmcpewogIGwgPC0gc3RyX3NwbGl0KHN0cmluZywgcGF0dGVybiA9Ii8iKQogIGwgPC0gbWFwX2RibChsLCB+YXMubnVtZXJpYygueFsxXSkvYXMubnVtZXJpYygueFsyXSkgKQogIHJldHVybihsKX0KCiMgc3RyX21hdGNoKCJjeXRvcGxhc21pYyB0cmFuc2xhdGlvbiAoR086MDAwMjE4MSkiLCAiXiguKz8pXFxzXFwoKC4rKVxcKSQiKVsyXQpHZW5lUmF0aW9fcGxvdC5mdW4gPC0gZnVuY3Rpb24oZW5yaWNoX2RmLCB0eHRfc2l6ZSA9IDE1LCBucl9wYXRoPTMsCiAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICBjb2w9YygiI2VkOTY4YyIsIiNmOWQxNGEiLCIjODhhMGRjIiwiI2U3ODQyOSIpKXsKICBkb3RfZGYgPC0gZW5yaWNoX2RmICU+JSAgIyBkb3RfZGYgPC0gZW5yaWNoX2RmJEdPX0Jpb2xvZ2ljYWxfUHJvY2Vzc18yMDIxICU+JQogICAge2lmKGdyZXBsKCJHTyIsLiRUZXJtW1sxXV0pKXttdXRhdGUoLiwgIlRlcm0iID0gc3RyX21hdGNoKC4kVGVybSwgIl4oLis/KVxcc1xcKCguKylcXCkkIilbLDJdLCAKICAgICAgICAgICAiR09pZCIgPSBzdHJfbWF0Y2goLiRUZXJtLCAiXiguKz8pXFxzXFwoKC4rKVxcKSQiKVssM10gKX1lbHNlIC59ICU+JQogICAgZmlsdGVyKEFkanVzdGVkLlAudmFsdWUgPCAwLjA1KSAlPiUKICAgIG11dGF0ZSgiLWxvZzEwKFAtdmFsdWUpIiA9IC1sb2cxMChQLnZhbHVlKSkgJT4lCiAgICBtdXRhdGUoR2VuZVJhdGlvID0gb3ZlcmxhcC5mdW4oLiRPdmVybGFwKSoxMDApIAogIAogIGRvdF9kZiA8LSBkb3RfZGYgJT4lCiAgICBncm91cF9ieShtb2R1bGUpICU+JSAKICAgIHRvcF9uKC4sIC1ucl9wYXRoLCBBZGp1c3RlZC5QLnZhbHVlKSAKICAKICBwIDwtIGdncGxvdChkb3RfZGYsIGFlcyh4ID0gYC1sb2cxMChQLXZhbHVlKWAsIHkgPSBmY3RfcmVvcmRlcihUZXJtLCBgLWxvZzEwKFAtdmFsdWUpYCksIGZpbGwgPSBtb2R1bGUsIGNvbCA9IG1vZHVsZSkpICsKICAgIGdlb21fY29sKHdpZHRoID0gLjA1LCBzaG93LmxlZ2VuZCA9IEYpICsKICAgIGdlb21fcG9pbnQoYWVzKHNpemUgPSBHZW5lUmF0aW8pKSArIHRoZW1lX2NsYXNzaWMoKSArIAogICAgc2NhbGVfZmlsbF9tYW51YWwodmFsdWVzID0gY29sLCBhZXN0aGV0aWNzID0gYygiZmlsbCIsICJjb2xvdXIiKSkgKwogICAgCiAgICBmYWNldF93cmFwKH5tb2R1bGUsIHNjYWxlcyA9ICdmcmVlJywgbmNvbCA9IDEpICsKICAgICNzY2FsZV94X2NvbnRpbnVvdXMoZXhwYW5kID0gYygwLCAxLjUpKSArCiAgICBjb29yZF9jYXJ0ZXNpYW4oY2xpcCA9IEYpICsKICAgIHNjYWxlX3hfY29udGludW91cyhsaW1pdHMgPSBmdW5jdGlvbih4KXtjKDAsICttYXgoMC4xLCB4KSl9KSArCiAgICBzY2FsZV9zaXplX2NvbnRpbnVvdXMoYnJlYWtzID0gYygxMCwgNTAsIDgwKSkgKwogICAgdGhlbWUoYXhpcy50aXRsZS55ID0gZWxlbWVudF9ibGFuaygpLAogICAgICAgICAgc3RyaXAudGV4dC54ID0gZWxlbWVudF90ZXh0KGhqdXN0ID0gMC4xLCBtYXJnaW49bWFyZ2luKGw9MCkpLAogICAgICAgICAgc3RyaXAuYmFja2dyb3VuZCA9IGVsZW1lbnRfYmxhbmsoKSwKICAgICAgICAgIHBhbmVsLnNwYWNpbmcgPSB1bml0KDEsICJsaW5lcyIpLAogICAgICAgICAgYXhpcy50ZXh0LnkgPSBlbGVtZW50X3RleHQoc2l6ZSA9IDEwKSwKICAgICAgICAgIHBhbmVsLmJvcmRlciA9IGVsZW1lbnRfYmxhbmsoKSkKICByZXR1cm4ocCkKfQoKZGYgPC0gYmluZF9yb3dzKGVucmljaF9kZltbMl1dLCBlbnJpY2hfZGZbWzNdXSkgJT4lCiAgZmlsdGVyKGRiID09ICJUcmFuc2NyaXB0aW9uX0ZhY3Rvcl9QUElzIiAmIG1vZHVsZSA9PSAiU000IiB8IGRiID09ICJLRUdHXzIwMjFfSHVtYW4iKQoKIyBkZXYubmV3KHdpZHRoPTMuNSwgaGVpZ2h0PTUsIG5vUlN0dWRpb0dEID0gVFJVRSkKKERfMiA8LSBHZW5lUmF0aW9fcGxvdC5mdW4oZGYpICsgdGhlbWUobGVnZW5kLnBvc2l0aW9uID0gIm5vbmUiKSApCgojIGdnc2F2ZShwYXN0ZTAoIi4vRmlndXJlcy8wNS8iLCAiRW5yaWNobWVudC5wbmciKSxEXzIsICB3aWR0aCA9IDMuOCwgaGVpZ2h0ID0gNSwgYmcgPSAid2hpdGUiKQpgYGAKCmBgYHtyIGNvbWJpbmUtcGFuZWxzfQojIyMjIyMjIyMjIyMjIyMjIyMjIyMjCiMgQ09NQklORSBBTEwgUEFORUxTICMKIyMjIyMjIyMjIyMjIyMjIyMjIyMjIwojIGRldi5uZXcod2lkdGg9NywgaGVpZ2h0PTgsIG5vUlN0dWRpb0dEID0gVFJVRSkgCkFfQyA8LSBwbG90X2dyaWQoQSwgQywgbmNvbCA9IDEsIHJlbF93aWR0aHMgPSBjKDEsIC40KSkKQV9CX0MgPC0gcGxvdF9ncmlkKEFfQywgQiwgbmNvbCA9IDIpCkQgPC0gcGxvdF9ncmlkKERfMSwgRF8yKQooRmlndXJlNSA8LSBwbG90X2dyaWQoQV9CX0MsIEQsIG5jb2wgPSAxLCByZWxfaGVpZ2h0cyA9IGMoMC4zMywgLjY2KSkgKQpgYGAKCg==